home *** CD-ROM | disk | FTP | other *** search
/ Acorn User: China / Acorn User China CD-ROM (UK) (Disc A) / Acorn User China CD-ROM (UK) (Disc A).bin / HENSA / MATHS / PGPLOT.ARC / Examples_f77_PGDEMO9 < prev    next >
Encoding:
Text File  |  1996-05-14  |  2.2 KB  |  81 lines
  1.       PROGRAM PGDEM9
  2. C-----------------------------------------------------------------------
  3. C Test program for PGPLOT: test of imaging routine PGPIXL.
  4. C-----------------------------------------------------------------------
  5.       INTEGER PGBEG
  6.       INTEGER N, NCOL, NLEV
  7.       PARAMETER (N=64, NCOL=32, NLEV=9)
  8.       INTEGER I,J,CI1,CI2
  9.       REAL F(N,N),FMIN,FMAX,R,G,B,CLEV(NLEV),TR(6)
  10.       INTEGER IA(N,N)
  11. C
  12. C Compute a suitable function.
  13. C
  14.       FMIN = F(1,1)
  15.       FMAX = F(1,1)
  16.       DO 20 I=1,N
  17.           DO 10 J=1,N
  18.               F(I,J) = COS(0.6*SQRT(I*2.)-0.4*J/3.)*COS(0.4*I/3)+
  19.      1                     (I-J)/REAL(N)
  20.               FMIN = MIN(F(I,J),FMIN)
  21.               FMAX = MAX(F(I,J),FMAX)
  22.    10     CONTINUE
  23.    20 CONTINUE
  24.       DO 25 I=1,N
  25.           DO 24 J=1,N
  26.               IA(I,J) = (F(I,J)-FMIN)/(FMAX-FMIN)*(NCOL-1)+16
  27.    24     CONTINUE
  28.    25 CONTINUE
  29. C
  30. C Open plot device and set up coordinate system. We will plot the
  31. C image within a unit square.
  32. C
  33.       IF (PGBEG(0,'?',1,1) .NE. 1) STOP
  34.       CALL PGQCOL(CI1, CI2)
  35.       IF (CI2.LT. 15+NCOL) THEN
  36.           WRITE (*,*) 'This program requires a device with at least',
  37.      1                15+NCOL,' colors'
  38.           STOP
  39.       END IF
  40.       CALL PGPAGE
  41.       CALL PGSCR(0, 0.0, 0.3, 0.2)
  42.       CALL PGSVP(0.05,0.95,0.05,0.95)
  43.       CALL PGWNAD(0.0, 1.0, 0.0, 1.0)
  44. C
  45. C Set up a color palette using NCOL indices from 16 to 15+NCOL.
  46. C
  47.       DO 30 I=1,NCOL
  48.           R = REAL(I-1)/REAL(NCOL-1)*0.8 + 0.2
  49.           G = MAX(0.0, 2.0*REAL(I-1-NCOL/2)/REAL(NCOL-1))
  50.           B = 0.2 + 0.4*REAL(NCOL-I)/REAL(NCOL)
  51.           CALL PGSCR(I+15, R, G, B)
  52.    30 CONTINUE
  53. C
  54. C Use PGPIXL to plot the image.
  55. C
  56.       CALL PGPIXL(IA,N,N, 1, N, 1, N, 0.0, 1.0, 0.0, 1.0)
  57. C
  58. C Annotation.
  59. C
  60.       CALL PGSCI(1)
  61.       CALL PGMTXT('t',1.0,0.0,0.0,'Test of PGPIXL')
  62.       CALL PGBOX('bcnts',0.0,0,'bcnts',0.0,0)
  63. C
  64. C Overlay a contour map.
  65. C
  66.       TR(1) = -1.0/REAL(N-1)
  67.       TR(2) = 1.0/REAL(N-1)
  68.       TR(3) = 0.0
  69.       TR(4) = -1.0/REAL(N-1)
  70.       TR(5) = 0.0
  71.       TR(6) = 1.0/REAL(N-1)
  72.       DO 40 I=1,NLEV
  73.           CLEV(I) = FMIN + (FMAX-FMIN)*REAL(I)/REAL(NLEV)
  74.    40 CONTINUE
  75.       CALL PGCONT(F, N, N, 1, N, 1, N, CLEV, NLEV, TR)
  76. C
  77. C Done.
  78. C
  79.       CALL PGEND
  80.       END
  81.